www.gusucode.com > 星梦奇缘交友网 1 > 星梦奇缘交友网 1.0源码程序/love/klatch_upload.asp
<!--#include file=conn.asp-->
<!--#include file=config.asp-->
<!--#include file=const.asp-->
<!--#include file=char.asp-->
<!-- #include File=inc/Upload_Class.asp-->
<%
'=========================================================
' File: klatch_upload.asp
' Version:3.0
' Date: 2005-9-22
' Script Written by xmrxw
'=========================================================
' Copyright (C) 2004,2005 920520.com All rights reserved.
' Web: http://www.920520.com,http://www.xmzxw.com
' Email: info@mssky.com,super@mssky.com
' QQ：10689579 Msn：zdlmicr@hotmail.com
'=========================================================
dim kid
response.buffer=true
if not founduser then
Errmsg=Errmsg+"<br>"+"<li>您还没有<a href=login.asp target=_blank>登陆</a>！"
response.Write(Errmsg)
response.end
end if
kid=checkStr(Request("kid"))
kid=cint(kid)
If Request("t")="1" Then
Upfile_Main()
Else
Main()
End If
sub Main()%>
<body leftmargin="0" topmargin="0">
<form name="form" method="post" action="klatch_upload.asp?t=1&Kid=<%=kid%>" enctype="multipart/form-data">
<table height="37%" border=0 cellpadding=0 cellspacing=0 style="width:100%;height:100%">
<tr>
<%if Cint(GroupSetting(171))=0 then%>
您没有本地上传图片的权限，请升级等级再来上传。
<%else
Dim PostRanNum
Randomize
PostRanNum = Int(900*rnd)+1000
Session("UploadCode") = Cstr(PostRanNum)
end if%>
<INPUT TYPE="hidden" NAME="UploadCode" value="<%=PostRanNum%>">
<Input type="hidden" name="act" value="upload">
<TD width="223" valign=top class=tablebody1 id="upid">
<input type="file" name="file1" width=200 value="" size="20">
</TD>
<td class=tablebody1 valign=top width=562>
<input type="submit" name="Submit" value="上传" onclick="parent.document.upform.Submit.disabled=true,
parent.document.upform.Submit2.disabled=true;">
</TD>
</tr>
</table>
</form>
</body>
</html>
<%end sub
Sub Upfile_Main()
Server.ScriptTimeOut=999999'要是你的空间支持上传的文件比较大，就必须设置。
'提交验证
If Not ChkPost Then
Response.End
End If
if not founduser then
Response.write "您还没有<a href=login.asp>登陆</a>，不能建立相册。请先<a href=login.asp>登录</a>，或者<a href=reg.asp>注册</a>"
Response.End
End If
if Cint(GroupSetting(170))<>0 and dateadd("n",Cint(GroupSetting(170)),myjoinDate)>=Now() then
Response.write "新注册用户"&Cint(GroupSetting(170))&"分钟后才能上传聚会图片，请稍后"
Response.End
end if
if Cint(GroupSetting(108))=0 then
Response.write "您没有本地上传的权限。"
Response.End
end if%>
<body leftmargin="0" topmargin="0">
<table height="37%" border=0 cellpadding=0 cellspacing=0 style="width:100%;height:100%" valign=top>
<tr><td class=tablebody1 valign=top>
<%
call UploadFile
%>
</td></tr>
</table>
</body>
</html>
<%
End Sub
Sub UploadFile()
Dim Forumupload
Dim FormName,FormPath,Filename,File_name,FileExt,Filesize,F_Type,rename
Dim upNum,dateupnum,OnceUPCount,FilePath,ChildFilePath
Dim Upload,File,F_FileName,F_ViewName,F_Filesize,F_FileExt,Previewpath,DrawInfo,InceptMaxFile
dim Uploadseting
Uploadseting=split(Uploadset,"|")
'定义变量
OnceUPCount = Request.Cookies("upNum")
If OnceUPCount = "" or Not Isnumeric(OnceUPCount) Then
OnceUPCount = 0
Else
OnceUPCount = Clng(OnceUPCount)
End If
If OnceUPCount >= Clng(GroupSetting(110)) then
Response.write "一次只能上传"&GroupSetting(110)&"个文件！"
Exit Sub
Else
InceptMaxFile = Clng(GroupSetting(110)) - OnceUPCount
End If
If Not IsNumeric(MyToday(2)) Then MyToday(2) = 0
If Clng(MyToday(2))>Clng(GroupSetting(111)) Then
Response.write "已超出了你每天上传的文件个数"&GroupSetting(111)&"个！"
Exit Sub
Else
If Clng(GroupSetting(111))-Clng(MyToday(2))<InceptMaxFile Then
InceptMaxFile = Clng(GroupSetting(111))-Clng(MyToday(2))
End If
End If
FilePath = CreatePath(CheckFolder) '上传目录路径
ChildFilePath = Replace(FilePath,CheckFolder,"")'不带系统上传目录的下级目录路径
Previewpath = UpfilePreview'预览图片目录路径
Previewpath = CreatePath(Previewpath)
If Uploadseting(4)="1" Then
DrawInfo = Uploadseting(5)
ElseIf Uploadseting(4)="2" Then
DrawInfo = Uploadseting(10)
Else
DrawInfo = ""
End If
If DrawInfo = "0" Then
DrawInfo = ""
Uploadseting(4) = 0
End If
Set Upload = New UpFile_Cls ''建立上传对象
Upload.UploadType=Cint(Uploadtype)
Upload.UploadPath=FilePath
Upload.InceptFileType = Replace(GroupSetting(173),"|",",")
Upload.MaxSize= Int(GroupSetting(174))
Upload.InceptMaxFile = InceptMaxFile '每次上传文件个数上限
Upload.ChkSessionName = "UploadCode" '防止重复提交,SESSION名与提交的表单要一致。
'预览图片设置
Upload.PreviewType= Cint(Uploadseting(0)) '设置预览图片组件类型
Upload.PreviewImageWidth= Uploadseting(1) '设置预览图片宽度
Upload.PreviewImageHeight= Uploadseting(2) '设置预览图片高度?
Upload.DrawImageWidth=Uploadseting(13) '设置水印图片或文字区域宽度
Upload.DrawImageHeight=Uploadseting(14) '设置水印图片或文字区域高度
Upload.DrawGraph=Uploadseting(11) '设置水印透明度
Upload.DrawFontColor=Uploadseting(7) '设置水印文字颜色
Upload.DrawFontFamily=Uploadseting(8) '设置水印文字字体格式
Upload.DrawFontSize= Uploadseting(6) '设置水印文字字体大小
Upload.DrawFontBold= Uploadseting(9) '设置水印文字是否粗体
Upload.DrawInfo= DrawInfo '设置水印文字信息或图片信息
Upload.DrawType= Uploadseting(4)'0=不加载水印 ，1=加载水印文字，2=加载水印图片
Upload.DrawXYType= Uploadseting(15)'"0" =左上，"1"=左下,"2"=居中,"3"=右上,"4"=右下
Upload.DrawSizeType= Uploadseting(3) '"0"=固定缩小，"1"=等比例缩小
If Uploadseting(12)<>"" or Uploadseting(12)<>"0" Then
Upload.TransitionColor = Uploadseting(12)'透明度颜色设置
End If
'执行上传
dim Kid
Kid=checkStr(request("kid"))
Call checkuserp(Kid) ''检查数据库是否超过限制
Upload.SaveUpFile
If Upload.ErrCodes<>0 Then
Response.write "错误："& Upload.Description & "[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
Exit Sub
End If
If Upload.Count > 0 Then
For Each FormName In Upload.UploadFiles
Set File = Upload.UploadFiles(FormName)
F_FileName = FilePath & File.FileName
'创建预览及水印图片
If Upload.PreviewType<>999 and File.FileType=1 then
F_Viewname = Previewpath & "pre" & Replace(File.FileName,File.FileExt,"") & "jpg"
'创建预览图片:Call CreateView(原始文件的路径,预览文件名及路径,原文件后缀)
Upload.CreateView F_FileName,F_Viewname,File.FileExt
End If
UploadSave F_FileName,ChildFilePath&File.FileName,File.FileExt,F_Viewname,File.FileSize,File.FileType,kid
Set File = Nothing
Next
Else
Response.write "请正确选择要上传的文件。[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
Exit Sub
End If
Call Suc_upload(Upload.Count,OnceUPCount)
Set Upload = Nothing
end sub
'检查数据库是否已经存在数量
Private sub checkuserp(Kid)
dim upnumid,uplist,Maxup
sql="select Klphoto from [Ms_klatch] where Kid="&Cint(Kid)&""
set rs=conn.execute(sql)
if not (rs.eof and rs.bof) then
upnumid=rs(0)
end if
rs.close
if upnumid<>0 and upnumid<>"" then
uplist=split(upnumid,",")
Maxup=(ubound(uplist)+1)
else
Maxup=0
end if
if cint(GroupSetting(172))<>0 and Maxup>=cint(GroupSetting(172)) then
Response.Write "对不起，您只能上传:"&GroupSetting(172)&"张图片。"
response.end
end if
end sub
'保存上传数据并返回附件ID
Sub UploadSave(FileName,ChildFileName,FileExt,ViewName,FileSize,F_Type,kid)
Dim ShwoFileName
ShwoFileName=Checkstr(Replace(FileName,CheckFolder,"UploadFile/"))
ChildFileName=Checkstr(ChildFileName)
if ViewName="" then
ViewName=FileName
end if
Conn.execute("insert into Ms_Upfile (Userid,Username,Typeid,Filename,Viewname,FileType,FileSize,Flag,FType) values ("&UserID&",'"&trim(membername)&"',2,'"&ChildFileName&"','"&ViewName&"','"&FileExt&"',"&Filesize&",0,"&F_Type&")")
dim uplistid
set rs=server.createobject("adodb.recordset")''提取出图片ID
sql="select FID from [Ms_Upfile] where Filename='"&ChildFileName&"'"
rs.Open sql,conn,1,1
if not (rs.eof and rs.bof) then
uplistid=rs("FID")
end if
rs.close
dim phlist
set rs=server.createobject("adodb.recordset")''读出聚会数据表中图片ID数据组
sql="select Klphoto from [Ms_klatch] where Kid="&Cint(Kid)&""
rs.Open sql,conn,1,1
if not (rs.eof and rs.bof) then
phlist=rs("Klphoto")
end if
rs.close
set rs=server.createobject("adodb.recordset")''写入聚会数据表
sql="select Klphoto from [Ms_klatch] where Kid="&Cint(Kid)&""
rs.Open sql,conn,1,3
if not (rs.eof and rs.bof) then
if phlist<>"" then''判断是否已有数据
rs("Klphoto")=rs("Klphoto")&","&uplistid
else
rs("Klphoto")=uplistid
end if
rs.update
end if
rs.close
Response.Write "图片上传成功！"
End sub
Sub Suc_upload(UpCount,upNum)
upNum = upNum + UpCount
Response.Cookies("upNum") = upNum
Dim iUserInfo
MyToday(2) = MyToday(2)+UpCount
iUserInfo= MyToday(0) & "|||" & MyToday(1) & "|||" &MyToday(2)
If upNum < Clng(GroupSetting(110)) And MyToday(2) < Clng(GroupSetting(111)) Then
Response.Write UpCount & "个文件上传成功,目前今天总共上传了" & MyToday(2) & "个文件 [ <a href=# onclick=history.go(-1)>继续上传</a> ]"
Else
Response.write UpCount & "个文件上传成功!本次已达到上传数上限。"
End If
Conn.Execute("UPDATE [Ms_user] SET UserToday = '" & iUserInfo &"' WHERE UserID = " & UserID)
End Sub
'读取上传目录
Function CheckFolder()
CheckFolder = Replace(Replace(SaveUpFilesPath,Chr(0),""),".","")
'在目录后加(/)
If Right(CheckFolder,1)<>"/" Then CheckFolder=CheckFolder&"/"
End Function
'按月份自动明名上传文件夹,需要ＦＳＯ组件支持。
Private Function CreatePath(PathValue)
Dim objFSO,Fsofolder,uploadpath
'以年月创建上传文件夹，格式：2003－8
uploadpath ="Kla_upload/"& year(now) & "-" & month(now)
If Right(PathValue,1)<>"/" Then PathValue = PathValue&"/"
On Error Resume Next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(Server.MapPath(PathValue & uploadpath))=False Then
objFSO.CreateFolder Server.MapPath(PathValue & uploadpath)
End If
If Err.Number = 0 Then
CreatePath = PathValue & uploadpath & "/"
Else
CreatePath = PathValue
End If
Set objFSO = Nothing
End Function%>